home *** CD-ROM | disk | FTP | other *** search
- '
- ' --- Windows CD Player ---
- ' from
- ' Jⁿrgen Vetter
- ' Gutenbergstra▀e 51
- ' 44139 Dortmund
- ' Fido 2:243/4601.6
- ' translated by TechSys Consulting, Inc.
- '
- ' Version 1.00
- '
- ' Version 1.5 optical prepared by Roland G. Hⁿlsmann
- '
- ' This program was tested on a 486/33 MHz 8 MB
- ' Windows 3.1
- ' DOS 6.0
- ' Mitsumi LU005S
- '
- '
- '
- ' There appear some differences on monitors with 1024x768 resolution.
- ' This program is F R E E W A R E. It is not allowed to charge anything
- ' for distribution. I don't accept any responsibility for damages on
- ' hardware or software which may appear by using this program.
- ' I also refuse all other duties.
- ' The source code may only be changed with my permission.
- '
- ' I thank Roland G. Hⁿlsmann for Profan Version 2.5
- '
- ' I would be glad to get in contact with some other programers
- ' Please write a NetMail in Fido.
- ' --------------------------------------------------------------------------------------------
- '
- ' *** program end -> 0
- '
- declare verkz%
- '
- ' *** running mode -> 1 shuffle
- '
- declare modus%
- ' *** 99 tracks can be saved
- '
- dim$ 99
- '
- ' *** CD variables
- '
- declare cdanz%,cdanzs$,cdlaen$,cdplay$,cdtrack$,cdzw$
- declare cdakt%,cdalt%,cdmin%,cdsec%,cdmalt%,cdsalt%
- '
- ' *** counting variables
- '
- declare sub%,ende%,zw$,zahl%,mci1$,trenn$,steppos$,disp$,zufall%,nummer%,zwert%
- '
- ' *** refresh all data -> 1
- '
- declare datenref%,timeref$
- '
- ' *** initialize variables
- '
- let verkz% = 1
- let cdakt% = 1
- let cdplay$ = "01:00:00:00"
- let datenref% = 1
- let trenn$ = ":"
- let modus% = 0
- color 1,15
-
- ' *---------------------------*
- ' * MCI Error occured *
- ' *---------------------------*
- proc mfehler
- @messagebox("Media error occured!",\
- "Ignore?",33)
- case @equ(%button,2):let verkz% = 0
- endproc
-
- ' *---------------------------*
- ' * Determines CD data *
- ' *---------------------------*
- proc cddaten
- let cdanzs$ = @mcisend$("status cd number of tracks")
- let cdlaen$ = @mcisend$("status cd length")
- let cdanz% = @val(cdanzs$)
- let sub% = 1
- let ende% = 1
- while ende%
- list$ sub% = @mcisend$(@add$("status cd length track ",@str$(sub%)))
- if @equ(sub%,cdanz%)
- let ende% = 0
- endif
- inc sub%
- wend
- endproc
- ' *---------------------------*
- ' * Fills box with data *
- ' *---------------------------*
- proc aufbau
- declare sub$
- clearlist
- let sub% = 1
- let ende% = 1
- while ende%
- let sub$=@str$(sub%)
- case @lt(sub%,10):let sub$=@add$("0",sub$)
- let zw$ = @add$(sub$," - ")
- addstring @add$(zw$,@list$(sub%))
- if @equ(sub%,cdanz%)
- let ende% = 0
- endif
- inc sub%
- wend
- endproc
-
- ' *---------------------------*
- ' * displayes CD data and *
- ' * und enables selection *
- ' *---------------------------*
- proc cdlist
- declare wahl$
- let wahl$=@ListBox$("Track - length",0)
- If @neq$(wahl$,"")
- let nummer% = @add(%getcursel,1)
- @mcisend$(@add$("play cd from ",@Str$(nummer%)))
- ifnot @equ(%mcierror,0)
- mfehler
- endif
- endif
- endproc
-
- ' *---------------------------*
- ' * Create screen *
- ' *---------------------------*
- proc schirm
- cls
- usebrush 1,0
- rectangle 0,0-420,42
- font 2
- color 14,0
- locate 1,2
- print "Current position:"
- locate 1,30
- print "Time.....:"
- locate 2,2
- print "Total....:"
- locate 2,30
- print "Total length:"
- locate 3,2
- print "Current track..:"
- locate 3,30
- print "Track length.:"
- loadsizedbmp "WINLOGO.BMP",0,42-420,258;0
- color 15,8
- tbox 5,2 - 7,8;0
- print "List"
- tbox 9,2 -11,8;0
- print "End"
-
- color 14,2
- tbox 5,11- 7,15;0
- print " 1 "
- tbox 5,17- 7,21;0
- print " 2 "
- tbox 5,23- 7,27;0
- print " 3 "
- tbox 9,11-11,15;0
- print " 4 "
- tbox 9,17-11,21;0
- print " 5 "
- tbox 9,23-11,27;0
- print " 6 "
- tbox 13,11-15,15;0
- print " 7 "
- tbox 13,17-15,21;0
- print " 8 "
- tbox 13,23-15,27;0
- print " 9 "
- tbox 17,11-19,15;0
- print " 1*"
- tbox 17,17-19,21;0
- print " 0 "
- tbox 17,23-19,27;0
- print " 2*"
-
- color 0,13
- tbox 5,30- 7,35;0
- print " << "
- tbox 5,37- 7,42;0
- print " -> "
- tbox 5,44- 7,49;0
- print " >> "
- tbox 9,30-11,35;0
- print " |< "
- tbox 9,37-11,42;0
- print " ## "
- tbox 9,44-11,49;0
- print " >| "
- tbox 13,30-15,35;0
- print " || "
- tbox 13,37-15,49;0
- print " Shuffle "
- tbox 17,37-19,49;0
- print " Normal "
-
- color 14,0
- endproc
-
- ' *---------------------------*
- ' * CD-Rom not found *
- ' *---------------------------*
- proc mfehler2
- @messagebox("CD-Rom not found or already used",\
- "Program stop!",16)
- let verkz% = 0
- endproc
- ' *---------------------------*
- ' * incorrect selection *
- ' *---------------------------*
- proc fehlaus
- @messagebox("Track doesn't exist",\
- "Note",0)
- endproc
- ' *---------------------------*
- ' * Exit program *
- ' *---------------------------*
- proc ende
- @messagebox("Do you really want to exit?",\
- "Qustion:",36)
- case @equ(%button,6):let verkz% = 0
- endproc
-
- ' *---------------------------*
- ' * Create MCI command *
- ' *---------------------------*
- proc mcivor
- let mci1$ = @str$(cdmin%)
- let mci1$ = @add$(mci1$,trenn$)
- let mci1$ = @add$(mci1$,@str$(cdsec%))
- let cdplay$ = @add$(@str$(cdakt%),trenn$)
- let cdplay$ = @add$(cdplay$,mci1$)
- endproc
-
- ' *---------------------------*
- ' * select next track *
- ' * has to be expanded *
- ' * *
- ' *---------------------------*
- proc bestimme
- ' let zufall% = @rnd (cdanz%)
- ' inc zufall%
- ' let cdakt% = zufall%
- endproc
-
- ' *---------------------------*
- ' * CD running mode *
- ' *---------------------------*
- proc cdmodus
- if @equ(modus%,1)
- color 13,5
- tbox 13,37-15,49;1
- print " Shuffle "
- color 0,13
- tbox 17,37-19,49;0
- print " Normal "
- else
- color 0,13
- tbox 13,37-15,49;0
- print " Shuffle "
- color 13,5
- tbox 17,37-19,49;1
- print " Normal "
- endif
- endproc
-
- ' *---------------------------*
- ' * Mode normal *
- ' *---------------------------*
- proc cdnormal
- let modus% = 0
- cdmodus
- endproc
-
- ' *---------------------------*
- ' * Activate shuffle *
- ' *---------------------------*
- proc cdshuffle
- let modus% = 1
- cdmodus
- endproc
-
- ' *---------------------------*
- ' * Rebuild all data *
- ' *---------------------------*
- proc datenerw
- color 14,0
- locate 2,21
- print cdanzs$
- locate 2,44
- print cdlaen$
- locate 3,21
- print @mid$(disp$,1,2)
- locate 3,44
- print @list$(cdakt%)
- let datenref% = 0
- let cdalt% = cdakt%
- endproc
-
- ' *---------------------------*
- ' * Data display *
- ' *---------------------------*
-
- proc datendisp
- color 14,0
- locate 1,44
- print @time$(0)
- let disp$ = @mcisend$("Status cd position")
- ifnot @equ(%mcierror,0)
- mfehler
- else
- locate 1,21
- print @mid$(disp$,4,5)
- if @equ(datenref%,1)
- datenerw
- endif
- let cdakt% = @val(@mid$(disp$,1,2))
- ifnot @equ(cdakt%,cdalt%)
- if @equ(modus%,1)
- bestimme
- endif
- datenerw
- endif
- endif
- endproc
-
- ' *---------------------------*
- ' * Play CD *
- ' *---------------------------*
- proc cdplay
- @mcisend$(@add$("play cd from ",cdplay$))
- ifnot @equ(%mcierror,0)
- mfehler
- endif
- endif
- endproc
-
- ' *---------------------------*
- ' * one track back *
- ' *---------------------------*
- proc cdback
- let zahl% = cdakt%
- dec zahl%
- if @gt(zahl%,0)
- let cdakt% = zahl%
- let cdalt% = cdakt%
- let cdplay$ = @str$(cdakt%)
- cdplay
- let datenref% = 1
- endif
- endproc
-
- ' *---------------------------*
- ' * one track forward *
- ' *---------------------------*
- proc cdfor
- let zahl% = cdakt%
- inc zahl%
- ifnot @gt(zahl%,cdanz%)
- let cdakt% = zahl%
- let cdalt% = cdakt%
- let cdplay$ = @str$(cdakt%)
- cdplay
- let datenref% = 1
- endif
- endproc
-
- ' *---------------------------*
- ' * CD back jumping *
- ' *---------------------------*
- proc cdstepb
- let steppos$ = @mcisend$("status cd position")
- let cdsec% = @val(@mid$(steppos$,7,2))
- let cdmin% = @val(@mid$(steppos$,4,2))
- let cdsec% = @sub(cdsec%,15)
- if @lt(cdsec%,0)
- @add(cdsec%,60)
- let cdmin% = @sub(cdmin%,1)
- ifnot @lt(cdmin%,0)
- mcivor
- cdplay
- endif
- else
- mcivor
- cdplay
- endif
- endproc
-
- ' *---------------------------*
- ' * Stop CD *
- ' *---------------------------*
- proc cdstop
- @MCISEND$("stop cd")
- ifnot @equ(%mcierror,0)
- mfehler
- else
- let cdakt% = 1
- let cdalt% = 1
- let datenref% = 1
- endif
- endproc
-
- ' *---------------------------*
- ' * CD forward jumping *
- ' *---------------------------*
- proc cdstepf
- let cdzw$ = @mid$(@mcisend$(@add$("status cd length track ",@str$(cdakt%))),1,5)
- let cdmalt% = @val(@mid$(cdzw$,1,2)
- let cdsalt% = @val(@mid$(cdzw$,4,2)
- let steppos$ = @mcisend$("status cd position")
- let cdsec% = @val(@mid$(steppos$,7,2))
- let cdmin% = @val(@mid$(steppos$,4,2))
- let cdsec% = @add(cdsec%,15)
- if @gt(cdsec%,60)
- sub cdsec%,60
- let cdmin% = @add(cdmin%,1)
- ifnot @gt(cdmin%,cdmalt%)
- ifnot @gt(cdsec%,cdsalt%)
- mcivor
- cdplay
- endif
- endif
- else
- mcivor
- cdplay
- endif
- endproc
-
- ' *---------------------------*
- ' * Stop CD at current position*
- ' *---------------------------*
- proc cdhold
- @MCISEND$("stop cd")
- ifnot @equ(%mcierror,0)
- mfehler
- else
- let cdplay$ = @mcisend$("status cd position")
- endif
- endproc
-
- ' *---------------------------*
- ' * 10+ *
- ' *---------------------------*
- proc asub1
- if @tmouse(17,11-19,15)
- locate 9,21
- color 14,2
- tbox 17,11-19,15;0
- print " 1*"
- tbox 17,17-19,21;0
- print " 0 "
- tbox 17,23-19,27;0
- print " 2*"
- color 2,10
- tbox 17,11-19,15;1
- print " 1*"
- color 14,0
- let nummer% = 10
- endif
- if @tmouse(17,23-19,27)
- locate 9,21
- color 14,2
- tbox 17,11-19,15;0
- print " 1*"
- tbox 17,17-19,21;0
- print " 0 "
- tbox 17,23-19,27;0
- print " 2*"
- color 2,10
- tbox 17,23-19,27;1
- print " 2*"
- color 14,0
- let nummer% = 20
- endif
- endproc
-
- ' *---------------------------*
- ' * Play track per display *
- ' *---------------------------*
- proc asub2
- ifnot @gt(nummer%,cdanz%)
- let cdakt% = nummer%
- let cdalt% = cdakt%
- let cdplay$ = @str$(cdakt%)
- cdplay
- let datenref% = 1
- else
- fehlaus
- endif
- color 14,2
- tbox 17,11-19,15;0
- print " 1*"
- tbox 17,17-19,21;0
- print " 0 "
- tbox 17,23-19,27;0
- print " 2*"
- let nummer% = 0
- endproc
-
- ' *---------------------------*
- ' * Selection by Display *
- ' *---------------------------*
- proc auswahl
- let zwert% = 999
- case @tmouse( 5,11- 7,15):let zwert% = 1
- case @tmouse( 5,17- 7,21):let zwert% = 2
- case @tmouse( 5,23- 7,27):let zwert% = 3
- case @tmouse( 9,11-11,15):let zwert% = 4
- case @tmouse( 9,17-11,21):let zwert% = 5
- case @tmouse( 9,23-11,27):let zwert% = 6
- case @tmouse(13,11-15,15):let zwert% = 7
- case @tmouse(13,17-15,21):let zwert% = 8
- case @tmouse(13,23-15,27):let zwert% = 9
- case @tmouse(17,11-19,15):asub1
- case @tmouse(17,17-19,21):let zwert% = 0
- case @tmouse(17,23-19,27):asub1
- if @neq(zwert%,999)
- let nummer% = @add(nummer%,zwert%)
- if @neq(nummer%,0)
- asub2
- endif
- endif
- endproc
-
- ' *---------------------------*
- ' * Mainprogram *
- ' *---------------------------*
- WindowTitle "PROFAN▓ CD-Player 1.5"
- windowstyle 10
- window 50,50-420,300
-
- Cls
-
- locate 9,8
- print "Initialize CD-Player ..."
- @mcisend$("open cdaudio alias cd")
- ifnot @equ(%mcierror,0)
- mfehler2
- case @equ(verkz%,0):end
- endif
- @mcisend$("set cd time format tmsf")
-
- cddaten
- aufbau
- schirm
- cdmodus
- datendisp
-
- while verkz%
- if @equ(%mousekey,1)
- if @tmouse( 5, 2- 7, 8)
- cdlist
- endif
- case @tmouse( 9, 2-11, 8):ende
- case @tmouse( 5,11-19,27):auswahl
- case @tmouse( 5,30- 7,35):cdback
- case @tmouse( 5,37- 7,42):cdplay
- case @tmouse( 5,44- 7,49):cdfor
- case @tmouse( 9,30-11,35):cdstepb
- case @tmouse( 9,37-11,42):cdstop
- case @tmouse( 9,44-11,49):cdstepf
- case @tmouse(13,30-15,35):cdhold
- case @tmouse(13,43-15,49):cdshuffle
- case @tmouse(17,43-19,49):cdnormal
- else
- datendisp
- endif
- wend
- end
-